#!/usr/bin/perl -w
#
# APPR - Automated Profiling and Performance Regression - is an
# extensible performance profiling framework for OpenOffice.org.
# 
# Copyright (C) 2005 Intel Corporation
# 
# GNU Lesser General Public License Version 2.1
# ======================================================================
# 
# This library is free software; you can redistribute it and/or modify
# it under the terms of the GNU Lesser General Public License as
# published by the Free Software Foundation; either version 2.1 of the
# License, or (at your option) any later version.
# 
# This library is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
# Lesser General Public License for more details.
# 
# You should have received a copy of the GNU Lesser General Public
# License along with this library; if not, write to the Free Software
# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301
# USA
# 
# ======================================================================

use strict;
use SVG;
use Getopt::Long;
use XML::Simple;
use Data::Dumper;

sub draw_bar;
sub draw_PERF;
sub abs_to_rel_time;
sub abs_time_to_x;
sub no_space;
sub draw_lib_opens;
sub draw_modules;
sub nuke_parens;
sub draw_proc_load;
sub draw_sys_load;
sub draw_text_box;
sub draw_ld_stats;
sub draw_legend;
sub draw_line_graph;
sub draw_rss;
sub draw_disk;
sub draw_vtune_stats;
    
my $report= 'report.xml';
my $outfile= 'graph.svg';
my $help_flag= '';
GetOptions('report=s' => \$report,
	   'output=s' => \$outfile,
	   'help' => \$help_flag);
open O, ">$outfile" or die "Couldn't open output file: $outfile\n";

if ($help_flag)
{
    print STDERR "usage: draw_graph --report=<input.xml> --output=<output.svg>\n";
    die "Bug author to do this with POD::Usage\n";
}

# my $file = "report.xml";
my $file = $report;
my $xs1 = XML::Simple->new();
my $doc = $xs1->XMLin($file, NormaliseSpace=>2);
my $id_suffix= 1;

#this gives it to you in a great format that lets you know 
#how to use it in code
#print Dumper($doc);

my $Runtime= $doc->{'RunTime'}->{'End'} - $doc->{'RunTime'}->{'Start'};
print "Runtime: ", $Runtime, " seconds \n";


# create an SVG object
my $doc_width= 1024;
my $doc_height= 768;
my $bar_height= 20;

my $svg= SVG->new(width=>$doc_width, height=>$doc_height); 

my $yp= 20;

draw_sys_load($yp);
draw_bar($yp, 'System Load', 0,'Sys_Load');

$yp+= 30;
draw_proc_load($yp);
draw_bar($yp, 'Process Load', 0, 'Proc_Load');

$yp+= 30;
draw_rss($yp);
draw_bar($yp, 'Resident Memory', 0, 'rmem');

$yp+= 30;
draw_disk($yp);
draw_bar($yp, "Disk Throughput", 0, "disk");


$yp+= 50;
draw_lib_opens($yp);
draw_modules($yp, {'config_mgr'=>'green'});
draw_bar($yp, $ENV{"REPORT_IDENTIFIER"}, 1, 'first_rect');
draw_PERF($yp);
draw_legend(0.75*$doc_width, $yp+40, 
	    {
		'green' => 'config_mgr',
		'blue' => 'Library opens',
		'red' => 'PERFORMANCE markers'
		}
	    );
$yp+=40;
draw_ld_stats(0.15*$doc_width, 250);
draw_vtune_stats(0.15*$doc_width, 400);

my $out = $svg->xmlify;
print O $out;



sub no_space
{
    my $string= shift;
    for ($string)
    {
	s/\s+/_/g;
    }
    return $string;
}

sub nuke_parens
{
    my $string= shift;
    for ($string)
    {
	s/[\(\)]+//g;
	
    }
    return $string;
}

sub abs_to_rel_time
{
    my $abs= shift;
    return $abs - $doc->{'RunTime'}->{'Start'};
}

sub abs_time_to_x
{
    my $abs= shift;
    my $T= abs_to_rel_time($abs);
    if ($T < 0)
    {
	print STDERR "negative time: " . sprintf("%.2f\n", $T);
	#die "negative time!\n";
    }
    if ($T > $Runtime)
    {
	print "$T is " . ($T - $Runtime) . "s after end of run!\n";
    }
    return $T / $Runtime * 0.8*$doc_width + 0.15*$doc_width;
    
}

#draw a bar and label it
# usage: draw_bar(<y_pos>, <label>, <time_output>, <id>)
sub draw_bar
{
    my $w= $doc_width * 0.8;
    my $h= $bar_height;
    my $x= $doc_width * 0.15;
    my $y= shift;
    my $label= shift;
    my $time_yesno= shift;
    my $id= shift;
    $svg->rect(x=>$x, y=>$y,
	       width=>$w, height=>$h,
	       fill=>'none',
	       id=>$id . $id_suffix,
	       stroke=>'black'
	       );
    $svg->text(
	       x=>1024 * 0.15 - 2,
	       y=>$y + 3 * $bar_height / 4,
	       id=>$id . '-' .$label . $id_suffix, 
	       style=>{'text-anchor'=>'end'}
	       )->cdata($label);
    if ($time_yesno)
    {
	$svg->text(
		   x=>$x,
		   y=>$y + $h + 12, 
		   id=>$id . '-start' . $id_suffix, 
		   style=>{'text-anchor'=>'start'}
		   )->cdata('0s');
	
	$svg->text(
		   x=>$x + $w,
		   y=>$y + $h + 12, 
		   id=>$id . '-end' . $id_suffix, 
		   style=>{'text-anchor'=>'end'}
		   )->cdata(sprintf("%.2f", $Runtime) . "s");
    }
}

sub draw_PERF
{
    my $y= shift;
    my $marker;
    
    my $i = 0;
    $marker = $doc->{'PERF_marker'};
	foreach my $a (@{$marker}) 
	{
	    $svg->line(
#		       id=>"PERF-$a->{'time'}$id_suffix",
		       x1=>abs_time_to_x($a->{'time'}), y1=> $y - 5,
		       x2=>abs_time_to_x($a->{'time'}), y2=> $y + 5 + $bar_height,
		       style=>
		       {
			   #more styles later?
			   'stroke'=>'red',
			   'stroke-linecap'=>'butt'
		       }
		       );
	    #text label?
    	}	
}

sub draw_lib_opens
{
    my $y= shift;
    my $lib;
    
    my $i = 0;
    $lib = $doc->{'library_load'};
	foreach my $a (@{$lib}) 
	{
	    $svg->line(
		       id=>"lib-$a->'time'}$id_suffix",
		       x1=>abs_time_to_x($a->{'time'}), y1=> $y - 0,
		       x2=>abs_time_to_x($a->{'time'}), y2=> $y + 0 + $bar_height,
		       style=>
		       {
			   #more styles later?
			   'stroke'=>'blue',
			   'stroke-linecap'=>'butt'
			   }
		       );
	    
    	}	
}

sub draw_modules
{
   my $y= shift;
   my $colors= shift;
   my $i = 0;
   my $module = $doc->{'Module'};
   foreach my $a (@{$module}) 
   {
       my $id=  "RTL-$i-" . nuke_parens(no_space($a->{'string'})). $id_suffix;
       my $width= abs_to_rel_time($a->{'end_time'}) / $Runtime * 0.8;
       my $color = $colors->{$a->{'mod_name'}};      
       $svg->rect(
		  id=>$id,
		  x=>abs_time_to_x($a->{'start_time'}),
		  y=>$y,
		  width=>$width,
		  height=>$bar_height,
		  stroke=>'none',
		  style=>
		  {
		      'fill-opacity'=>'0.2',
		      'fill'=>$color

		  }
		  );
$i++;
   }
}

#pinched from above
sub draw_proc_load
{
    my $y= shift;
    my $i = 0;
    my $monitor = $doc->{'Monitor'};
    my @x_values;
    my @proc_user_load;
    my @proc_sys_load;
# ok, this is sort of a risky deal, because we rely that the xml
# is in chronological order b/c it was generated in that way.
    foreach my $a (@{$monitor}) 
    {
        push @x_values, $a->{'time'};
	push @proc_user_load, $a->{'procuserload'};
	push @proc_sys_load, $a->{'procsysload'};
    }    
    draw_line_graph($y, \@x_values, \@proc_user_load, 100,
		    {
			'stroke'=> 'red',
			'fill' => 'red',
			'stroke-width' => '1'
			},
		    'proc_user_load'
		    );
    draw_line_graph($y,\@x_values, \@proc_sys_load, 100,
		    {
			'stroke' => 'blue',
			'fill' => 'blue',
			'stroke-width' => '1'
			},
		    'proc_sys_load'
		    );
}


#pinched from above
sub draw_sys_load
{
    my $y= shift;
    my $i = 0;
    my $monitor = $doc->{'Monitor'};
    my @x_values;
    my @user_load;
    my @sys_load;
# ok, this is sort of a risky deal, because we rely that the xml
# is in chronological order b/c it was generated in that way.
    foreach my $a (@{$monitor}) 
    {
        push @x_values, $a->{'time'};
	push @user_load, $a->{'userload'};
	push @sys_load, $a->{'systemload'};
    }    

    draw_line_graph($y, \@x_values, \@user_load, 100, 
		    {
			'stroke' => 'red',
			'fill' => 'red',
			'stroke-width' => '1'
			},
		    'user_load');
    draw_line_graph($y, \@x_values, \@sys_load, 100, 
		    {
			'stroke' => 'blue',
			'fill' => 'blue',
			'stroke-width' => '1'
			},
		    'sys_load');
    
}

# usage 
# draw_text_box(x, y, title, @keys, @values)
#
#  This function sucks because:
#   1: it centers the text, which can make for awkard sizes
#
sub draw_text_box
{
    my $x= shift;
    my $y= shift;
    my $title= shift;
    my $keys= shift; #ref to array
    my $values= shift; #ref to array
    
    my $width; 
    my $height= @{$keys}*12 + 15 + 3; #magic numbers
    my $longest_string_1= 0;
    my $longest_string_2= 0;
    for my $element (@{$keys})
    {
	if (length $element > $longest_string_1)
	{
	    $longest_string_1= length $element;
	}
    }
    for my $element (@{$values})
    {
	if (length $element > $longest_string_2)
	{
	    $longest_string_2= length $element;
	}
    }
    my $mw= 10; #magic width number
    #20 the two offsets below
    #5 margin
    $width= ($longest_string_1 + $longest_string_2)*$mw + 20 + 5;
    my $x_center= $x + $width/2;
    $svg->rectangle(
		    x=>$x, y=>$y,
		    width=>$width, height=>$height,
		    fill=>'none',
		    id=>"box-$title-$x-$y-$id_suffix",
		    style=>
		    {
			'stroke'=>'black'
		    }
		    );
    $svg->text(
	       x=>$x_center,
	       y=>$y + 12, #magic number
	       id=>"box-$title-$x-$y-title-$id_suffix",
	       style=>
	       {
		   'text-anchor'=>'middle'
	       }
	       )->cdata($title);
    $svg->line(x1=>$x, 
	       y1=> $y + 15, #magic number
	       x2=>$x + $width,
	       y2=>$y + 15, #magic number, again
	       id=>"box-$title-$x-$y-title-underscore-$id_suffix"
	       );
    
    my $i= 1;
    for my $element (@{$keys})
    {
	$svg->text(
		   x=>$x_center - 10, #magic number
		   y=>$y + 15 + $i*12, #two magic numbers added and multiplied
		   id=>"box-$title-$x-$y-key-$i-$id_suffix",
		   style=>
		   { 
		       'text-anchor'=>'end'
		       }
		   )->cdata($element);
	$i++;
    }
    $i= 1;
    for my $element (@{$values})
    {
	$svg->text(
		   x=>$x_center + 10, #magic number
		   y=>$y + 15 + $i*12, #see above
		   id=>"box-$title-$x-$y-value-$i-$id_suffix"
		   )->cdata($element);
	$i++;
    }
}

#usage:
#  draw_ld_stats(x, y)
sub draw_ld_stats
{
    my $x= shift;
    my $y= shift;
    my @keys;
    my @values;
    push @keys, "Total startup time in dynamic loader";
    push @values, sprintf("%.3f", $doc->{'ld_debug'}->{'total_startup_time_in_dynamic_loader'});
    push @keys, "Time needed for relocation";
    push @values, sprintf("%.3f", $doc->{'ld_debug'}->{'total_startup_time_in_dynamic_loader'});
    push @keys, "Number of relocations";
    push @values, $doc->{'ld_debug'}->{'number_of_relocations'};
    push @keys, "Number of relocations from cache";
    push @values, $doc->{'ld_debug'}->{'number_of_relocations_from_cache'};
    push @keys, "Number of relative relocations";
    push @values, $doc->{'ld_debug'}->{'number_of_relative_relocations'};
    push @keys, "Time needed to load objects";
    push @values, sprintf("%.3f", $doc->{'ld_debug'}->{'time_needed_to_load_objects'});
    push @keys, "Final number of relocations";
    push @values, $doc->{'ld_debug'}->{'final_number_of_relocations'};
    push @keys, "Final number of relocations from cache";
    push @values, $doc->{'ld_debug'}->{'final_number_of_relocations_from_cache'};
    
    draw_text_box($x, $y, "Runtime Linker Statistics", \@keys, \@values);
}

#usage draw_legend(x,y,{color=>label})
sub draw_legend
{
    my $x= shift;
    my $y= shift;
    my $hash_ref= shift;

    my $line_length= 10;
    my $offset= 5;
    my $step= 12;
    my $key;
    for $key (keys %{$hash_ref})
    {
	$svg->line(
		   x1=>$x,
		   y1=>$y - $step / 2,
		   x2=>$x + $line_length,
		   y2=>$y - $step / 2,
		   id=>"legend-$x-$y-$key-$id_suffix",
		   style=>
		   {
		       'stroke'=>$key,
		       'stroke-width'=>'1'
		   }
		   );
	$svg->text(
		   x=>$x + $line_length + $offset,
		   y=>$y,
		   id=>"legend-$x-$y-$key-label-$id_suffix"
		   )->cdata(${$hash_ref}{$key});
	$y+= $step;
    }
}


#usage:
#  draw_line_graph(y, \@x_values, \@y_values, 
#                  peak, \%style, id)
sub draw_line_graph
{
    my $y= shift;
    my $x_val= shift;
    my $y_val= shift;
    my $peak= shift;
    my $style= shift;
    my $id= shift;
    
    my $num_of_elements = @{$x_val};

    my @x_list;
    my @y_list;

    push @x_list, $doc_width * 0.15;
    push @y_list, $y + $bar_height;

    for (my $i= 0; $i < $num_of_elements; $i++)
    { 
	unless ($x_val->[$i] > $doc->{'RunTime'}->{'End'})
	{
	    push @x_list, abs_time_to_x($x_val->[$i]);
	    push @y_list, $bar_height - $y_val->[$i] * $bar_height / $peak + $y;
	}
    }

    push @x_list, $doc_width * 0.15 + $doc_width * 0.8;
    push @y_list, $y + $bar_height;

    my $points= $svg->get_path(
			      x => \@x_list,
			      y => \@y_list,
			      '-type' => 'polyline',
			      '-closed' => 'true'
			      );
    $svg->polyline(
		   %$points,
		   id =>"line_graph-$y-$id-$id_suffix",
		   style => $style
		   );    
}

#usage draw_rss(y)
sub draw_rss
{
    my $y= shift;
    my $monitor = $doc->{'Monitor'};
    my $max_rss;
    my @x_values;
    my @rss;
    foreach my $a (@{$monitor})
    {
	push @x_values, $a->{'time'};
	push @rss, $a->{'rmem'};
	$max_rss = $a->{'maxrmem'};
    }
    draw_line_graph($y, \@x_values, \@rss, $max_rss,
		    {
			'stroke' => 'green',
			'fill' => 'green',
			'stroke-width' => '1'
			},
		    'rss_mem'
		    );
    $svg->text(
	       x=>$doc_width*(0.8 + .15) + 2,
	       y=>$y + 10,
	       id=>"rss-top-label-$y-$id_suffix"
	       )->cdata(sprintf("%.2f", $max_rss/1024) . 'M');
}

#usage draw_disk(y)
sub draw_disk
{
    my $y= shift;
    my $monitor = $doc->{'Monitor'};
    my $max_throughput= 0;
    my @x_values;
    my @disk_read_throughput;
    my @disk_write_throughput;
    foreach my $a (@{$monitor})
    {
	push @x_values, $a->{'time'};
	push @disk_read_throughput, $a->{'disk_throughput_read'};
	push @disk_write_throughput, $a->{'disk_throughput_write'};
	if ($a->{'disk_throughput_read'} > $max_throughput)
	{
	    $max_throughput= $a->{'disk_throughput_read'};
	}
	if ($a->{'disk_throughput_write'} > $max_throughput)
	{
	    $max_throughput= $a->{'disk_throughput_write'};
	}
	if ($max_throughput == 0)
	{
	    print "disk throughput zero!  making 5*1024*1024\n";
	    $max_throughput= 5*1024*1024;
	}
    }
    draw_line_graph($y, \@x_values, \@disk_read_throughput,
		    $max_throughput,
		    {
			'stroke'=>'red',
			'fill'=>'red',
			'stroke-width'=>'1'
			},
		    'disk-read'
		    );
    draw_line_graph($y, \@x_values, \@disk_write_throughput,
		    $max_throughput,
		    {
			'stroke'=>'blue',
			'fill'=>'blue',
			'stroke-width'=>'1'
			},
		    'disk-write'
		    );
    $svg->text(
	       x=>$doc_width*(0.8 + .15) + 2,
	       y=>$y+10,
	       id=>"disk-top-label-$y-$id_suffix"
	       )->cdata(sprintf("%.1f", $max_throughput / 1024 / 1024 / 0.2) . 'MB/s');
}


sub draw_vtune_stats {
    my $x = shift;
    my $y = shift;
    my $dy = 15;
	return if (not $doc->{'VTune'});
    my @xv = sort { $b->{'CT'} <=> $a->{'CT'}} @{$doc->{'VTune'}->{'VTD'}};
    $svg->text(
        x => 0.5*$doc_width - 150,
        y => $y
        )->cdata('VTune Function Hotspots');
    $y += $dy;
    foreach my $v (@xv) { # (@{$doc->{'VTune'}->{'VTD'}}) 
        $svg->text(
            x=>$x,
            y => $y + $dy + 4,
            id=> "f-$y"
        )->cdata($v->{'modfun'});
        $svg->rectangle(
            x=> 0.5*$doc_width - 50,
            y=> $y + $dy - $dy/2 + 2,
            height => $dy/2 - 2,
            width => $doc_width * 0.7 * $v->{'CT'} / 100,
            style => {'fill'=>'blue'}
        );
        $svg->rectangle(
            x=> 0.5*$doc_width - 50,
            y=> $y + $dy,
            height => $dy/2 - 2,
            width => $doc_width * 0.7 * $v->{'IR'}/ 100,
            style => {'fill'=>'red'}
        );
        $y += $dy;
    }
}

